| SOCR ≫ | DSPA ≫ | Topics ≫ |
This DSPA section Appendix.3.1 (Primitive Surfaces with and without Boundaries) is part of the DSPA Appendix on visualizaiton of geometric and parametric surfaces. This DSPA Appendix (3) covers the following 3 topics:
A saddle point is a point on the surface represented by a function \(z=z(x,y)\), where the gradient slopes (partial derivatives) of orthogonal function components defining the surface are trivial (\(0\)), however the point does not represent a local extremum on both axes, as may be expected. We already showed a simple example of a saddle point earlier, which we rendered as a surface. Now we will illustrate the parametric definition of a surface with a saddle point and it’s triangulated representation as a mesh3d.
library(plotly)
library (geometry)
# Plotly layout
axs <- list(
backgroundcolor="rgb(200,200,200)", # gray
gridcolor="rgb(255,255,255)", # white
showbackground=TRUE,
zerolinecolor="rgb(255,255,255)" # white
)
n <- 36
h <- 1/(n-1)
r = seq(h, 1, length.out=n)
theta = seq(0, 2*pi, length.out=100)
grid.df <- expand.grid(r=r, theta=theta)
x <- c(grid.df$r * cos(grid.df$theta), 0)
y <- c(grid.df$r * sin(grid.df$theta), 0)
z <- sin(x*y)
mat <- matrix(
c(x,y,z),
ncol = 3,
dimnames = list(NULL, c("x", "y", "z"))
)
triangulated <- delaunayn(mat[,1:2])
# now figure out the colormap
zmean <- apply(triangulated, MARGIN=1, function(row){mean(mat[row,3])})
library(scales)
facecolor = colour_ramp(
colorRampPalette(c("pink", "purple"))(20)
)(rescale(x=zmean))
plot_ly(
x=x, y=y, z=z,
i=triangulated[,1]-1, j=triangulated[,2]-1, k=triangulated[,3]-1,
facecolor=facecolor,
type="mesh3d",
opacity = 0.7,
contour=list(show=TRUE, color="#000", width=15)
) %>%
layout(
title="Triangulated Saddle Point surface",
scene=list(
xaxis=axs,
yaxis=axs,
zaxis=axs,
camera=list(
eye=list(x=1.75,y=-0.7,z=0.75)
)
)
)Below, we show three complementary examples of rendering synthetic geometric shapes; convex shapes (cone, sphere) and a non-convex surface (complex). It’s worthwhile reviewing the fundamentals of the spherical coordinate system representation.
# library(plotly)
# sweep or define (u,v) spherical coordiante parameter ranges
phi <- seq(from = 0, to = 2*pi, by = ((2*pi - 0)/(200 - 1)))
psi <- seq(from = 0, to = pi, by = ((pi - 0)/(200 - 1)))
#p <- plot_ly(x = ~x, y = ~y, z = ~z, type = 'surface', opacity=1,
# contour=list(show=TRUE, color="#000", width=15, lwd=10)) %>%
# layout(title = paste("Layout ", shape),
# scene = list(xaxis=x_label,yaxis=y_label, zaxis=z_label))
#p
# shape=="complex")
# rendering (u,v) parametric surfaces requires x,y,z arguments to be 2D arrays
# In out case, the three coordinates have to be 200*200 parameterized tensors/arrays
r1 = 2 + sin(3 * phi + 5 * psi) # r = 2 + sin(7phi+5psi)
x1 = (r1 * cos(phi)) %o% sin(psi) # x = r*cos(phi)*sin(psi)
y1 = (r1 * sin(phi)) %o% sin(psi) # y = r*sin(phi)*sin(psi)
z1 = r1 %o% cos(psi) # z = r*cos(psi)
#shape=="cone")
h2= 10 # cone height
r2 = seq(from = 0, to = h2, by = ((h2 - 0)/(200 - 1))) # r = radius
x2 = 3* ((h2 - r2)/h2 ) %o% rep(1, 200) # x = 3*r
y2 = 3* ((h2 - r2)/h2 ) %o% sin(phi) # y = r*sin(phi)
z2 = 3* ((h2 - r2)/h2 ) %o% cos(phi) # z = r*cos(phi)
#shape=="sphere")
r3 = 1 # r = 1
x3 = r3 * cos(phi) %o% sin(psi) # x = r*cos(phi)*sin(psi)
y3 = r3 * sin(phi) %o% sin(psi) # y = r*sin(phi)*sin(psi)
z3 = r3 * rep(1, 200) %o% cos(psi) # still need z to be 200*200 parameterized tensor/array
shape_names <- c("complex", "cone", "sphere")
# https://plot.ly/r/custom-buttons/
#p <- plot_ly(x = ~x, y = ~y, z = ~z, type = 'surface', opacity=1,
# contour=list(show=TRUE, color="#000", width=15, lwd=10),
# layout=layout_shapes)
# updatemenus component
updatemenus <- list(
list(
active = -1,
type = 'buttons',
buttons = list(
list(
label = shape_names[1],
method = "update",
args = list(list(visible = c(TRUE, FALSE, FALSE)),
list(title = shape_names[1]))),
list(
label = shape_names[2],
method = "update",
args = list(list(visible = c(FALSE, TRUE, FALSE)),
list(title = shape_names[2]))),
list(
label = shape_names[3],
method = "update",
args = list(list(visible = c(FALSE, FALSE, TRUE)),
list(title = shape_names[3])))
)
)
)
p <- plot_ly(hoverinfo="none", legendshow=FALSE, showscale = FALSE) %>%
add_trace(x = ~x1, y = ~y1, z = ~z1, type = 'surface', opacity=1, visible=T,
contour=list(show=TRUE, color="#000", width=15, lwd=10,
opacity=1.0, hoverinfo="none", legendshow=F)) %>%
add_trace(x = ~x2, y = ~y2, z = ~z2, type='surface', opacity=1,visible=F,
contour=list(show=TRUE, color="#000", width=15, lwd=10,
opacity=1.0, hoverinfo="none", legendshow=F)) %>%
add_trace(x = ~x3, y = ~y3, z = ~z3, type = 'surface', opacity=0.7,visible=F,
contour=list(show=TRUE, color="#000", width=15, lwd=10,
opacity=0.7, hoverinfo="none", legendshow=F)) %>%
layout(title = "Choose a Shape", showlegend = FALSE,
updatemenus = updatemenus)
p